home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / PET / S-Super PET / (s)t2.d64 / PLOT-8300p < prev    next >
Encoding:
Text File  |  2009-01-18  |  14.4 KB  |  371 lines
  1.     1 ! plot-8300P
  2.     2        call set_constants
  3.     3        dim y(MAXSIZE), ylab$(MAXLABEL), xlab$(MAXLABEL)
  4.     4        print clr$;"plot-8300P - D. A. Staley, Thornhill": print 
  5.     5        print "Requires MicroBASIC Version 1.0": print
  6.     6        print "Enter   1  for a LINEAR plot."
  7.     7        print "        2  for a LOG-LINEAR plot."
  8.     8        print "        3  for a LOG-LOG plot." : print 
  9.     9        call get_params
  10.    10        call get_data
  11.    11        call scale_data
  12.    12        call draw_border
  13.    13        call annotate_yaxis
  14.    14        call get_labels
  15.    15        call annotate_xaxis
  16.    16        call plot_graph
  17.    17        call print_labels
  18.    18 ! stop
  19.    19 
  20.    20   proc set_constants
  21.    21        LAST = 2 : MAXSIZE = 600 : MAXLABEL = 25
  22.    22        spi = 120: cpi = 10 : lpi = 6 : hlpi = 12
  23.    23        spl = 8  : vsi = 48 : dh  = 0
  24.    24        bs$ = chr$(8) : lf$ = chr$(10) : up$ = chr$(11)
  25.    25        clr$= chr$(12): rtn$= chr$(13) : esc$= chr$(27)
  26.    26        sp$ = chr$(32): pd$ = chr$(46) : us$ = chr$(95)
  27.    27        vl$ = chr$(124) : bl$ = rpt$(sp$,78)
  28.    28        HMI$= esc$ + chr$(31) : VMI$ = esc$ + chr$(30)
  29.    29        hlf$= esc$ + chr$(85) : nhlf$= esc$ + chr$(68)
  30.    30        nlf$= esc$ + chr$(10) : ebp$ = esc$ + chr$(54)
  31.    31        dbp$= esc$ + chr$(53) : gon$ = esc$ + chr$(51)
  32.    32        gof$= esc$ + chr$(52)
  33.    33   endproc 
  34.    34 
  35.    35   proc get_params
  36.    36        type%  = fnparam("        Type of plot ",1,3)
  37.    37        h      = fnparam("Plot height (inches) ",0,11)
  38.    38        paper  = fnparam("         Paper width ",0,14)
  39.    39        marg   = fnparam("         Left margin ",0,paper-1)
  40.    40        wide   = fnparam("          Plot width ",0,paper-marg-0.5)
  41.    41   endproc 
  42.    42 
  43.    43   def fnparam(prompt$,low,hi)
  44.    44        loop 
  45.    45           print prompt$;: input num$
  46.    46           test$ = fnnumeric$(num$)
  47.    47           if test$  = "yes" then numb = value(num$)
  48.    48           if test$ <> "yes" then numb = low-1
  49.    49           if ( numb >= low and numb <= hi ) then quit 
  50.    50           print up$;bl$;rtn$;up$;
  51.    51        endloop 
  52.    52        fnparam = numb
  53.    53   fnend 
  54.    54 
  55.    55   def fnnumeric$(num$)
  56.    56        fnnumeric$ = "yes"
  57.    57        if len(num$) = 0 then fnnumeric$ = "no"
  58.    58        for i = 1 to len(num$)
  59.    59            a = ord(num$(i:i))
  60.    60            if a < 46 or a > 57 or a = 47 then fnnumeric$="no"
  61.    61        next i
  62.    62   fnend
  63.    63 
  64.    64   proc get_data
  65.    65        on eof ignore : on ioerr ignore 
  66.    66        on conv 
  67.    67           call error("Not a plot file.")
  68.    68        endon 
  69.    69        loop 
  70.    70           input "      Data file name ? ",nm$
  71.    71           open #8, "disk/0."+ nm$, input
  72.    72           if io_status = 0 then quit 
  73.    73           print up$;bl$;rtn$;up$;
  74.    74        endloop 
  75.    75        input #8, origin, delta
  76.    76        if io_status <> 0 then call error(io_status$)
  77.    77        if origin <= 0 and type% = 3 then call error("Origin out of range")
  78.    78        if delta <= 0 then call error("Descending time axis?")
  79.    79        n=0
  80.    80        while io_status <> LAST
  81.    81           n = n + 1 : input #8, y(n)
  82.    82           if io_status = 1 or io_status = 3 then call error(io_status$)
  83.    83        endloop 
  84.    84        n = n - 1 : close #8
  85.    85        print " sample origin   = ";origin
  86.    86        print " sample interval = ";delta
  87.    87        print "Number of points = ";n
  88.    88        if type% <> 3  and  2*n/spi > wide
  89.    89           n = int(spi*wide/2)
  90.    90           print "The first "+value$(n)+" points will fit plot width."
  91.    91        elseif type% <> 3
  92.    92           wide = 2*n/spi
  93.    93        endif 
  94.    94   endproc 
  95.    95 
  96.    96   proc error(msg$)
  97.    97        print msg$: close #8
  98.    98        stop
  99.    99   endproc 
  100.   100 
  101.   101   proc scale_data
  102.   102        max = y(1) : min = y(1)
  103.   103        for i = 1 to n
  104.   104            if y(i) > max then max = y(i)
  105.   105            if y(i) < min then min = y(i)
  106.   106        next i
  107.   107        if min <= 0 and type% > 1 then call error("Data out of range")
  108.   108        if type% > 1
  109.   109            maxex = int(log(max)/log(10)) : minex = int(log(min)/log(10))
  110.   110            maxlog = -10^maxex*int(-abs(max)/10^maxex)*sgn(max)
  111.   111            minlog =  10^minex*int(min/10^minex)
  112.   112            t = vsi/(log(maxlog/minlog)) : ysp = 8 : scale = h*t
  113.   113            for i = 1 to n
  114.   114                y(i) = scale*(log(y(i)/min))
  115.   115            next i
  116.   116        else 
  117.   117            pow = log(max-min)/log(10) : ex = int(pow)
  118.   118            if pow = ex then ex = ex - 1
  119.   119            min =  10^ex * int( min/10^ex )
  120.   120            max = -10^ex * int(-abs(max)/10^ex ) * sgn(max)
  121.   121            maxl = max/10^ex : minl = min/10^ex : t = vsi/(max-min)
  122.   122            ysp = -int(-h*t*10^ex): h = (1+ysp)/(t*10^ex) : scale = h*t
  123.   123            for i = 1 to n
  124.   124                y(i) = scale*(y(i)-min)
  125.   125            next i
  126.   126        endif 
  127.   127   endproc 
  128.   128 
  129.   129   proc draw_border
  130.   130        open #4,"ieee4",output 
  131.   131        print #4,nm$;rtn$;lf$;lf$;HMI$;chr$(13);
  132.   132        print #4,rpt$(sp$,cpi*marg);rpt$(us$,cpi*wide);
  133.   133        print #4,HMI$;chr$(7);bs$;HMI$;chr$(1);
  134.   134        print #4,VMI$;chr$(9);hlf$;rpt$(hlf$+vl$,h*hlpi);
  135.   135        print #4,VMI$;chr$(4);nlf$;VMI$;chr$(9);
  136.   136        print #4,HMI$;chr$(7);bs$;HMI$;chr$(13);
  137.   137        print #4,ebp$;rpt$(us$,cpi*wide);dbp$;
  138.   138        print #4,HMI$;chr$(7);sp$;HMI$;chr$(1);
  139.   139        print #4,VMI$;chr$(3);lf$;VMI$;chr$(9);
  140.   140        print #4,rpt$(vl$+nhlf$,h*hlpi);
  141.   141        print #4,HMI$;chr$(13);sp$;
  142.   142   endproc 
  143.   143 
  144.   144   proc annotate_yaxis
  145.   145        print #4,VMI$;chr$(9);nlf$;
  146.   146        expon$ = value$(minex)
  147.   147        if type% = 1 then expon$ = value$(ex)
  148.   148        print #4,rpt$(bs$,len(expon$)+3);"x10";nhlf$;expon$;
  149.   149        print #4,hlf$;VMI$;chr$(11);lf$;VMI$;chr$(ysp+1);nlf$;
  150.   150        if type% > 1
  151.   151            nu = maxlog/10^maxex : tens = maxex - minex
  152.   152            cy = -int(-tens) : b$ = value$(nu*10^tens) + " -"
  153.   153            d = 0 : st = 0 : l$ = "no"
  154.   154            loop 
  155.   155                a$ = value$(nu*10^tens) + " -"
  156.   156                if (str$(a$,1,1) <> "-") then a$ = " " + a$
  157.   157                print #4,rpt$(bs$,len(a$));lf$;a$;
  158.   158                call get_newnu
  159.   159                if newnu*10^tens < minlog/10^minex
  160.   160                    if l$ = "yes" then quit 
  161.   161                    l$ = "yes" : newnu = minlog/10^minex/10^tens
  162.   162                endif 
  163.   163                d = d + scale*log(nu/newnu)
  164.   164                ys = int(d-st) : st = st + ys : nu = newnu
  165.   165                print #4,VMI$;chr$(ys+1);
  166.   166                if nu = 1
  167.   167                    tens = tens - 1 : nu = 10
  168.   168                endif 
  169.   169                if nu*10^tens < minlog/10^minex then quit 
  170.   170            endloop 
  171.   171            if str$(b$,1,1) <> "-" then a$ = " " + b$
  172.   172        else 
  173.   173            dh = -vsi*int(-h*hlpi)/hlpi - (maxl-minl)*ysp
  174.   174            if dh >= 0 then print #4,VMI$;chr$(dh+1);lf$;VMI$;chr$(ysp+1);
  175.   175            if dh < 0 then print #4,VMI$;chr$(1-dh);nlf$;VMI$;chr$(ysp+1);
  176.   176            for i = maxl to minl step -1
  177.   177                a$ = value$(i) + " -"
  178.   178                if str$(a$,1,1) <> "-" then a$ = " " + a$
  179.   179                print #4,rpt$(bs$,len(a$));lf$;a$;
  180.   180            next i
  181.   181        endif 
  182.   182        print #4,bs$;
  183.   183   endproc 
  184.   184 
  185.   185   proc get_newnu
  186.   186        if cy = 1
  187.   187            newnu = nu - 1
  188.   188            if nu = 1
  189.   189               nu = 10 : newnu = 9 : tens = tens - 1
  190.   190            endif 
  191.   191        elseif cy = 2
  192.   192            newnu = nu - 2
  193.   193            if nu - 2*int(nu/2) > 0 then newnu = nu -1
  194.   194            if nu = 2
  195.   195               nu = 20 : newnu = 10 : tens = tens -1
  196.   196            endif 
  197.   197        elseif cy >= 3
  198.   198            if nu > 5 then newnu = 5
  199.   199            if nu <= 5 and nu > 2 then newnu = 2
  200.   200            if nu = 2 then newnu = 1
  201.   201        endif 
  202.   202   endproc 
  203.   203 
  204.   204   proc get_labels
  205.   205        w = cpi*marg - len(a$) : s$ = rpt$("x",w) : nl% = lpi*h
  206.   206        print : print "Y-axis label.   << to change, +++ to end."
  207.   207        print : print "  ";s$
  208.   208        loop 
  209.   209            for i% = 1 to nl%
  210.   210                i1% = i% : yln% = -1 : linput ylab$(i%) : again$ = "no"
  211.   211                if idx(ylab$(i%),"+++") <> 0 then yln% = i% - 1
  212.   212                if yln% > -1 then quit 
  213.   213                if idx(ylab$(i%),"<<") <> 0 then again$ = "yes"
  214.   214                if again$ = "yes" then quit 
  215.   215            next i%
  216.   216            if again$ = "no" then quit 
  217.   217            print rpt$(up$,i1%);
  218.   218        endloop 
  219.   219        w = cpi*wide : s$ = rpt$("x",w)
  220.   220        print : print "X-axis label,  << to change, +++ to end."
  221.   221        print : print "  ";s$
  222.   222        loop 
  223.   223            for i% = 1 to MAXLABEL
  224.   224                i1% = i% : xln% = -1 : linput xlab$(i%)
  225.   225                if idx(xlab$(i%),"+++") <> 0 then xln% = i% - 1
  226.   226                again$ = "no"
  227.   227                if xln% > -1 then quit 
  228.   228                if idx(xlab$(i%),"<<") <> 0 then again$ = "yes"
  229.   229                if again$ = "yes" then quit 
  230.   230            next i%
  231.   231            if again$ = "no" then quit 
  232.   232            print rpt$(up$,i1%);
  233.   233        endloop 
  234.   234   endproc 
  235.   235 
  236.   236   proc annotate_xaxis
  237.   237        if type% =  3 then call logarithmic_xaxis_annotation
  238.   238        if type% <> 3 then call linear_xaxis_annotation
  239.   239   endproc 
  240.   240 
  241.   241   proc logarithmic_xaxis_annotation
  242.   242        print #4,VMI$;chr$(11);
  243.   243        xs = wide*spi/log(n) : minex = int(log(origin)/log(10))
  244.   244        tens = 0 : cy = -int(-log(n)/log(10))
  245.   245        nu = int(origin/10^minex) : call get_newnux : fx = 0
  246.   246        if nu*10^minex < origin
  247.   247            fx = xs*log(newnu*10^minex/origin) : nu = newnu
  248.   248        endif 
  249.   249        if nu = 10
  250.   250            nu = 1 : minex = minex + 1
  251.   251        endif 
  252.   252        x = int(fx) : d = fx : st = x
  253.   253        while st <= wide*spi
  254.   254            a$ = value$(nu*10^tens) : call print_numbers
  255.   255            call get_newnux  : d = d + xs*log(newnu/nu)
  256.   256            x = int(d-st) : st = st + x : nu = newnu
  257.   257            if nu = 10
  258.   258                tens = tens + 1 : nu = 1
  259.   259            endif 
  260.   260        endloop 
  261.   261        expon$ = value$(minex) : lx = wide*spi-st+x
  262.   262        sh = wide*spi : call show_power
  263.   263   endproc 
  264.   264 
  265.   265   proc get_newnux
  266.   266        if cy = 1
  267.   267           newnu = nu + 1
  268.   268        elseif cy = 2
  269.   269           newnu = nu + 2
  270.   270           if nu - 2*int(nu/2) > 0 then newnu = nu + 1
  271.   271        elseif cy >= 3
  272.   272           if nu >= 5 then newnu = 10
  273.   273           if nu < 5 and nu >= 2 then newnu = 5
  274.   274           if nu = 1 then newnu = 2
  275.   275        endif 
  276.   276   endproc 
  277.   277 
  278.   278   proc print_numbers
  279.   279        call print_big_space
  280.   280        if x > 0 then print #4,HMI$;chr$(x+1);sp$;
  281.   281        print #4,HMI$;chr$(1);vl$;lf$;HMI$;chr$(9);
  282.   282        print #4,rpt$(bs$,int(len(a$)/2));a$;
  283.   283        print #4,rpt$(bs$,int((len(a$)+1)/2));nlf$;
  284.   284   endproc 
  285.   285 
  286.   286   proc print_big_space
  287.   287        while x >= 120
  288.   288            print #4,HMI$;chr$(121);sp$;
  289.   289            x = x - 120 : ste = ste + 120
  290.   290        endloop 
  291.   291   endproc 
  292.   292 
  293.   293   proc linear_xaxis_annotation
  294.   294        pow = log(n*delta)/log(10) : ex = int(pow)
  295.   295        if pow = ex then ex = ex - 1
  296.   296        min1 = 10^ex*int(origin/10^ex) : min2 = min1/10^ex
  297.   297        print #4,VMI$;chr$(11);
  298.   298        xs = 2*10^ex/delta : adx = 1
  299.   299        if int( 2*n/xs ) < 3
  300.   300            xs = xs/2 : adx = 5 : ex = ex - 1
  301.   301        endif 
  302.   302        k = min2 + adx : fx = xs - 2*(origin-min1)/delta
  303.   303        if origin = min1
  304.   304            fx = 0 : k = min2
  305.   305        endif 
  306.   306        x = int(fx) : d = fx : st = x
  307.   307        while st <= 2*n
  308.   308            a$ = value$(k) : call print_numbers
  309.   309            k = k + adx : d = d + xs
  310.   310            x = int(d-st) : st = st + x
  311.   311        endloop 
  312.   312        expon$ = value$(ex) : lx = 2*n-st+x
  313.   313        sh = 2*n : call show_power
  314.   314   endproc 
  315.   315 
  316.   316   proc show_power
  317.   317        st = st - x
  318.   318        if lx > 0
  319.   319            x = int(lx) : ste = st
  320.   320            call print_big_space : st = ste + x
  321.   321            print #4,HMI$;chr$(x+1);sp$;
  322.   322        endif 
  323.   323        print #4,HMI$;chr$(13);lf$;sp$;sp$;
  324.   324        print #4,"x10";nhlf$;expon$;hlf$;
  325.   325        print #4,rpt$(bs$,len(expon$)+5);HMI$;chr$(13);
  326.   326        st = st-12*int(sh/12) : print #4,rpt$(bs$,int(sh/12));
  327.   327        if st > 0 then print #4,HMI$;chr$(st+1);bs$;HMI$;chr$(13);
  328.   328        print #4,VMI$;chr$(13);nlf$;VMI$;chr$(9);
  329.   329   endproc 
  330.   330 
  331.   331   proc plot_graph
  332.   332        told% = 0 : print #4,gon$;
  333.   333        if type% = 3
  334.   334            xs = wide*spi/(2*log(n))
  335.   335            st = 0 : nst = 0 : d = 0
  336.   336        endif 
  337.   337        for i = 1 to n
  338.   338            t% = y(i) + 0.5*sgn(y(i))
  339.   339            r% = t% - told% : told% = t%
  340.   340            if r% < 0 then print #4,rpt$(lf$,-r%);pd$;
  341.   341            if r% = 0 then print #4,pd$;
  342.   342            if r% > 0 then print #4,rpt$(nlf$,r%);pd$;
  343.   343            if type% = 3
  344.   344                in = xs*log((i+1)/i) : d = d + in
  345.   345                nst = int(d-st) : st = st + nst
  346.   346                print #4,rpt$(sp$,nst);
  347.   347            else 
  348.   348                print #4,sp$;
  349.   349            endif 
  350.   350        next i
  351.   351        print #4,gof$;HMI$;chr$(13);VMI$;chr$(9)
  352.   352   endproc 
  353.   353 
  354.   354   proc print_labels
  355.   355        if type% = 1 then top% = 1 + (scale*(max-min)-y(n))/spl
  356.   356        if type% = 2 then top% = 1 + (scale*log(max/min)-y(n))/spl
  357.   357        if type% = 3 then top% = 1 + (scale*log(max/min)-y(n))/spl
  358.   358        mv% = top% - (nl%-yln%)/2
  359.   359        if mv% >= 0 then print #4, rpt$(nlf$,mv%);
  360.   360        if mv% <  0 then print #4, rpt$(lf$,-mv%)
  361.   361        for i% = 1 to yln%
  362.   362             print #4,ylab$(i%)
  363.   363        next i%
  364.   364        mv% = 4 + (nl%-yln%)/2
  365.   365        print #4,rpt$(lf$,mv%);
  366.   366        for i% = 1 to xln%
  367.   367             print #4,rpt$(sp$,cpi*marg);xlab$(i%)
  368.   368        next i%
  369.   369        close #4
  370.   370   endproc 
  371.